home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / TECHNICA / AUTOCAD / H107.ZIP / AUTOCM30.ZIP / AUTOCMND.LSP < prev    next >
Lisp/Scheme  |  1991-08-29  |  48KB  |  1,276 lines
  1. ;ac
  2. ;            ***  AUTOCMND.LSP  ***
  3. ; To use the crosshairs and status line
  4. ; to start a command based on the entity
  5. ; under the crosshairs, to edit the entity
  6. ; under the crosshairs or to manipulate layers
  7. ; based on the entity under the crosshairs.
  8. ;
  9. ; Version 3 now includes text manipulation
  10. ;
  11. ; Eric Michalowsky
  12. ; 1753 Cloverfield Boulevard
  13. ; Santa Monica
  14. ; CA 90404
  15. ; (213) 829-7535
  16. ;
  17. ; See AutoCmnd.doc for registration information
  18. ;
  19. (princ "\n\nAC<LOAD> Loading UNREGISTERED AUTOCOMMAND...")
  20. (princ "\nAC<LOAD> Loading AUTOCOMMAND...please be patient ---")
  21. (defun spin (/ xcntr)
  22.   (if (= $num nil) (setq $num 4))
  23.   (cond ((= (rem $num 4) 0) (princ "|/-\\|"))
  24.         ((= (rem $num 4) 1) (princ "/-\\|/"))
  25.         ((= (rem $num 4) 2) (princ "-\\|/-"))
  26.         ((= (rem $num 4) 3) (princ "\\|/-\\"))
  27.   )
  28.   (setq $num (1+ $num))
  29.   (princ)
  30. )
  31. (spin)
  32. (defun acerr (lerr)
  33.   (setvar "HIGHLIGHT" achi)
  34.   (setvar "CMDECHO" accecho)
  35.   (setvar "MENUECHO" acmecho)
  36.   (setvar "COORDS" accoord)
  37.   (setvar "SNAPMODE" acsnap)
  38.   (setq *error* olderr)
  39.   (princ)
  40. )
  41. (spin)
  42. (defun RTD (ang)
  43.   (/ (* ang 180.0) pi)
  44. )
  45. (defun DTR (ang)
  46.   (* pi (/ ang 180.0))
  47. )
  48. (spin)
  49. (defun mainprom ()
  50.   (setvar "COORDS" 0)
  51.   (prompt "\nAC<MAIN> MOVE CROSSHAIRS OVER ENTITY FOR RECOGNITION -> Press Capital Letter ->")
  52.   (prompt "\nAC<MAIN> Array/Break/Copy/Draw/Erase/oFfset/stretcH/Insert/Layer/Move/New/...")
  53.   (prompt "\nAC<MAIN>    mirrOr/Pedit/Quit/Rotate/Scale/Text/redraW/eXplode/Zoom/?: ")
  54. )
  55. (spin)
  56. (defun lyrprom ()
  57.   (prompt "\n\nAC<LAYER> MOVE CROSSHAIRS OVER ENTITY FOR RECOGNITION -> Press Capital Letter ->")
  58.   (prompt "\nAC<LAYER> 1 only/All/Delete/Freeze/Off/Quit/Set/eXit/?: ")
  59. )
  60. (defun zoomprom ()
  61.   (prompt "\n\nAC<ZOOM> Zoom - All/Biggest/Extents/Previous/Smallest/Window/eXit/?")
  62.   (prompt "\nAC<ZOOM> Pan  - 2 pt.pan/Down/Left/Right/Up/eXit/?: ")
  63. )
  64. (defun textprom ()
  65.   (prompt "\nAC<TEXT> MOVE CROSSHAIRS OVER ENTITY FOR RECOGNITION -> Press Capital Letter ->")
  66.   (prompt "\nAC<TEXT> Continue/Edit/Height/Justification/Quit/Replace/...")
  67.   (prompt "\nAC<TEXT>    Style/x-Value/redraW/eXit/?: ")
  68. )
  69. (spin)
  70. (defun acpauz(/ acz aczz)
  71.   (setq acz 1)
  72.   (while acz
  73.     (initget 2 " ")
  74.     (setq aczz (getkword "\nAC<PAUSE> Press Enter to continue..."))
  75.     (if (or (= aczz nil) (= aczz " "))
  76.       (setq acz nil )
  77.     )
  78.   )
  79.   (graphscr)
  80. )
  81. (spin)
  82. (defun edithelp ()
  83.   (textscr)
  84.   (prompt "\n\n\n\n\n\n\n\n\n\n")
  85.   (prompt "\nAC<HELP> AUTO-COMMAND Main Menu Help                              ")
  86.   (prompt "\nAC<HELP>")
  87.   (prompt "\nAC<HELP> Move the crosshairs over an entity on the screen...")
  88.   (prompt "\nAC<HELP> If the entity is recognized, it is reported on the status line...")
  89.   (prompt "\nAC<HELP>")
  90.   (prompt "\nAC<HELP> ╔═════╤═════════════════════╦═════╤══════════════════════╗")
  91.   (prompt "\nAC<HELP> ║Press│  To                 ║Press│  To                  ║")
  92.   (prompt "\nAC<HELP> ╠═════╪═════════════════════╬═════╪══════════════════════╣")
  93.   (prompt "\nAC<HELP> ║                                                        ║")
  94.   (prompt "\nAC<HELP> ║                                                        ║")
  95.   (prompt "\nAC<HELP> ║                                                        ║")
  96.   (prompt "\nAC<HELP> ║       If you                                           ║")
  97.   (prompt "\nAC<HELP> ║              REGISTER                                  ║")
  98.   (prompt "\nAC<HELP> ║       you will see a help screen here                  ║")
  99.   (prompt "\nAC<HELP> ║       so                                               ║")
  100.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  101.   (prompt "\nAC<HELP> ╟─      now                                             ─╢")
  102.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  103.   (prompt "\nAC<HELP> ║       now                                              ║")
  104.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  105.   (prompt "\nAC<HELP> ║       now                                              ║")
  106.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  107.   (prompt "\nAC<HELP> ╟─      now                                             ─╢")
  108.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  109.   (prompt "\nAC<HELP> ╚═════╧══════════════════════════════════════════════════╝")
  110.   (acpauz)
  111.   (editmenu)
  112. )
  113. (spin)
  114. (defun lyrhelp ()
  115.   (textscr)
  116.   (prompt "\n\n\n\n\n\n\n\n\n\n")
  117.   (prompt "\nAC<HELP> AUTOCOMMAND Layer Menu Help                           ")
  118.   (prompt "\nAC<HELP>")
  119.   (prompt "\nAC<HELP> Move the crosshairs over an entity on the screen...")
  120.   (prompt "\nAC<HELP> If the entity is recognized, it is reported on the status line...")
  121.   (prompt "\nAC<HELP>")
  122.   (prompt "\nAC<HELP> ╔═════╤═════════════════════╦═════╤══════════════════════╗")
  123.   (prompt "\nAC<HELP> ║Press│  To                 ║Press│  To                  ║")
  124.   (prompt "\nAC<HELP> ╠═════╪═════════════════════╬═════╪══════════════════════╣")
  125.   (prompt "\nAC<HELP> ║                                                        ║")
  126.   (prompt "\nAC<HELP> ║                                                        ║")
  127.   (prompt "\nAC<HELP> ║                                                        ║")
  128.   (prompt "\nAC<HELP> ║       If you                                           ║")
  129.   (prompt "\nAC<HELP> ║              REGISTER                                  ║")
  130.   (prompt "\nAC<HELP> ║       you will see a help screen here                  ║")
  131.   (prompt "\nAC<HELP> ║       so                                               ║")
  132.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  133.   (prompt "\nAC<HELP> ╟─      now                                             ─╢")
  134.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  135.   (prompt "\nAC<HELP> ║       now                                              ║")
  136.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  137.   (prompt "\nAC<HELP> ║       now                                              ║")
  138.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  139.   (prompt "\nAC<HELP> ╟─      now                                             ─╢")
  140.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  141.   (prompt "\nAC<HELP> ╚═════╧══════════════════════════════════════════════════╝")
  142.   (acpauz)
  143.   (lyrmenu)
  144. )
  145. (spin)
  146. (defun txthelp ()
  147.   (textscr)
  148.   (prompt "\n\n\n\n\n\n\n\n\n\n")
  149.   (prompt "\nAC<HELP> AUTOCOMMAND Text Menu Help                            ")
  150.   (prompt "\nAC<HELP>")
  151.   (prompt "\nAC<HELP> Move the crosshairs over an entity on the screen...")
  152.   (prompt "\nAC<HELP> If the entity is recognized, it is reported on the status line...")
  153.   (prompt "\nAC<HELP>")
  154.   (prompt "\nAC<HELP> ╔═════╤═════════════════════╦═════╤══════════════════════╗")
  155.   (prompt "\nAC<HELP> ║Press│  To                 ║Press│  To                  ║")
  156.   (prompt "\nAC<HELP> ╠═════╪═════════════════════╬═════╪══════════════════════╣")
  157.   (prompt "\nAC<HELP> ║                                                        ║")
  158.   (prompt "\nAC<HELP> ║                                                        ║")
  159.   (prompt "\nAC<HELP> ║                                                        ║")
  160.   (prompt "\nAC<HELP> ║       If you                                           ║")
  161.   (prompt "\nAC<HELP> ║              REGISTER                                  ║")
  162.   (prompt "\nAC<HELP> ║       you will see a help screen here                  ║")
  163.   (prompt "\nAC<HELP> ║       so                                               ║")
  164.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  165.   (prompt "\nAC<HELP> ╟─      now                                             ─╢")
  166.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  167.   (prompt "\nAC<HELP> ║       now                                              ║")
  168.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  169.   (prompt "\nAC<HELP> ║       now                                              ║")
  170.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  171.   (prompt "\nAC<HELP> ╟─      now                                             ─╢")
  172.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  173.   (prompt "\nAC<HELP> ╚═════╧══════════════════════════════════════════════════╝")
  174.   (acpauz)
  175.   (txtmenu)
  176. )
  177. (spin)
  178. (defun zoomhelp ()
  179.   (textscr)
  180.   (prompt "\n\n\n\n\n\n\n\n\n\n")
  181.   (prompt "\nAC<HELP> AUTO-COMMAND Zoom Menu Help                                ")
  182.   (prompt "\nAC<HELP> ╔═════╤═════════════════════╦═════╤══════════════════════╗")
  183.   (prompt "\nAC<HELP> ║Press│  To                 ║Press│  To                  ║")
  184.   (prompt "\nAC<HELP> ╠═════╪═════════════════════╬═════╪══════════════════════╣")
  185.   (prompt "\nAC<HELP> ║                                                        ║")
  186.   (prompt "\nAC<HELP> ║                                                        ║")
  187.   (prompt "\nAC<HELP> ║                                                        ║")
  188.   (prompt "\nAC<HELP> ║       If you                                           ║")
  189.   (prompt "\nAC<HELP> ║              REGISTER                                  ║")
  190.   (prompt "\nAC<HELP> ║       you will see a help screen here                  ║")
  191.   (prompt "\nAC<HELP> ║       so                                               ║")
  192.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  193.   (prompt "\nAC<HELP> ╟─      now                                             ─╢")
  194.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  195.   (prompt "\nAC<HELP> ║       now                                              ║")
  196.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  197.   (prompt "\nAC<HELP> ║       now                                              ║")
  198.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  199.   (prompt "\nAC<HELP> ╟─      now                                             ─╢")
  200.   (prompt "\nAC<HELP> ║             REGISTER                                   ║")
  201.   (prompt "\nAC<HELP> ╚═════╧══════════════════════════════════════════════════╝")
  202.   (acpauz)
  203.   (zoomenu)
  204. )
  205. ;********************  Main Program  **************************************
  206. (defun C:AC ()
  207.   (setq olderr *error* *error* acerr)
  208.   (setq acsnap (getvar "SNAPMODE"))
  209.   (setq accecho (getvar "CMDECHO"))
  210.   (setq acmecho (getvar "MENUECHO"))
  211.   (setq accoord (getvar "COORDS"))
  212.   (setq achi (getvar "HIGHLIGHT"))
  213.   (setvar "SNAPMODE" 0)
  214.   (setvar "CMDECHO" 0)
  215.   (setvar "MENUECHO" 2)
  216.   (setvar "COORDS" 0)
  217.   (setvar "HIGHLIGHT" 0)
  218.   (editmenu)
  219.   (setvar "HIGHLIGHT" 1)
  220.   (setvar "CMDECHO" 1)
  221.   (setvar "MENUECHO" 0)
  222.   (setvar "SNAPMODE" acsnap)
  223.   (setq *error* olderr)
  224.   (princ)
  225. )
  226. (spin)
  227. (defun EDITMENU (/ mma mmbang mmbnm mmbx mmbxp mmby mmbyp mmbz mmbzp mmclr mme
  228.                    mment mmkey mmlist mmlyr mmmlp mmodi mmscan mmsclr
  229.                    mmslp mmslp2)
  230.   (mainprom)
  231.   (setq mmlist (list 65 97 66 98 67 99 68 100 69 101 70 102 72 104 73 105
  232. ;                     A  a  B  b  C  c  D   d  E   e  F   f  H   h  I   i
  233.          76 108 77 109 78 110 79 111 80 112 81 113 82 114 83 115
  234. ;         L   l  M   m  N   n  O   o  P   p  Q   q  R   r  S   s
  235.          84 116 85 117 87 119 88 120 90 122 63))
  236. ;         T   t  U   u  W   w  X   x  Z   z  ?
  237.   (setq mmmlp 1)
  238.   (while mmmlp
  239.     (setq mmslp nil)
  240.     (while (not mmslp)
  241.       (setq mmscan (grread 1)
  242.             mmkey (car (cdr mmscan)))
  243.       (if (member mmkey mmlist)
  244.         (progn
  245.           (setvar "HIGHLIGHT" 1)
  246.           (setvar "COORDS" 1)
  247.           (cond
  248.             ((= mmkey 63)
  249.               (setq mmmlp nil)
  250.               (setq mmslp 1)
  251.               (edithelp)
  252.             )
  253.             ((or (= mmkey 65) (= mmkey 97))     ;A - Array command
  254.               (setq mmmlp nil)
  255.               (setq mmslp 1)
  256.               (prompt "\n ")
  257.               (prompt "\nAC<ARRAY> Starting the Array command...")
  258.               (command ".ARRAY" mmslp2)
  259.             )
  260.             ((or (= mmkey 66) (= mmkey 98))        ;B - Break command
  261.               (prompt "\nAC<REGISTER> Register now and you can use BREAK!!")
  262.               (acpauz)
  263.               (mainprom)
  264.             )
  265.             ((or (= mmkey 67) (= mmkey 99))     ;C - Copy command
  266.               (prompt "\nAC<REGISTER> Register now and you can use COPY!!")
  267.               (acpauz)
  268.               (mainprom)
  269.             )
  270.             ((or (= mmkey 69) (= mmkey 101))    ;E - Erase command
  271.               (setq mmmlp nil)
  272.               (setq mmslp 1)
  273.               (prompt "\n ")
  274.               (prompt "\nAC<ERASE> Starting the Erase command...")
  275.               (command ".ERASE" mmslp2)
  276.             )
  277.             ((or (= mmkey 70) (= mmkey 102))    ;F - oFfset command
  278.               (setq mmmlp nil)
  279.               (setq mmslp 1)
  280.               (prompt "\n ")
  281.               (prompt "\nAC<OFFSET> Starting the oFfset command...")
  282.               (if (null $mmodi)
  283.                 (setq $mmodi 0)
  284.               )
  285.               (setq mmodi (getdist (strcat
  286.  "\nAC<OFFSET> Enter/Pick offset distance <" (rtos $mmodi) ">...")))
  287.               (if (= mmodi nil)
  288.                 (setq mmodi $mmodi)
  289.                 (setq $mmodi mmodi)
  290.               )
  291.               (command ".OFFSET" mmodi mment)
  292.             )
  293.             ((or (= mmkey 72) (= mmkey 104))    ;stretcH command
  294.               (setq mmmlp nil)
  295.               (setq mmslp 1)
  296.               (prompt "\n ")
  297.               (prompt "\nAC<STRETCH> Starting Stretch command...")
  298.               (command ".STRETCH" "C")
  299.             )
  300.             ((or (= mmkey 73) (= mmkey 105))    ;I - Insert command
  301.               (prompt "\nAC<REGISTER> Register now and you can use INSERT!!")
  302.               (acpauz)
  303.               (mainprom)
  304.             )
  305.             ((or (= mmkey 76) (= mmkey 108))    ;L - Layer Manipulation
  306.               (lyrmenu)
  307.             )
  308.             ((or (= mmkey 77) (= mmkey 109))    ;M - Move command
  309.               (setq mmmlp nil)
  310.               (setq mmslp 1)
  311.               (prompt "\n ")
  312.               (prompt "\nAC<MOVE> Starting the Move command...")
  313.               (command ".MOVE" mmslp2)
  314.             )
  315.             ((or (= mmkey 78) (= mmkey 110) (= mmkey 68) (= mmkey 100))
  316.               (setq mmmlp nil)      ;N/D - New (draw) command
  317.               (setq mmslp 1)
  318.               (setvar "MENUECHO" 2)
  319.               (setvar "CMDECHO" 0)
  320.               (drawcmnd)
  321.             )
  322.             ((or (= mmkey 79) (= mmkey 111))    ;O - mirrOr command
  323.               (setq mmmlp nil)
  324.               (setq mmslp 1)
  325.               (prompt "\n ")
  326.               (prompt "\nAC<MIRROR> Starting the mirrOr command...")
  327.               (command ".MIRROR" mmslp2)
  328.             )
  329.             ((or (= mmkey 80) (= mmkey 112))     ;P - Pedit command
  330.               (prompt "\nAC<REGISTER> Register now and you can use PEDIT!!")
  331.               (acpauz)
  332.               (mainprom)
  333.             )
  334.             ((or (= mmkey 81) (= mmkey 113))    ;Q - Quit
  335. (prompt "\n\nAC<QUIT>                       AUTOCOMMAND !")
  336. (prompt "\nAC<QUIT> The routine that will REVOLUTIONIZE the way you use AutoCad!!")
  337.               (setq mmmlp nil)
  338.               (setq mmslp 1)
  339.             )
  340.             ((or (= mmkey 82) (= mmkey 114))    ;R - Rotate command
  341.               (setq mmmlp nil)
  342.               (setq mmslp 1)
  343.               (prompt "\n ")
  344.               (prompt "\nAC<ROTATE> Starting Rotate command...")
  345.               (command ".ROTATE" mmslp2)
  346.             )
  347.             ((or (= mmkey 83) (= mmkey 115))    ;S - Scale command
  348.               (setq mmmlp nil)
  349.               (setq mmslp 1)
  350.               (prompt "\n ")
  351.               (prompt "\nAC<SCALE> Starting Scale command...")
  352.               (command ".SCALE" mmslp2)
  353.             )
  354.             ((or (= mmkey 84) (= mmkey 116))          ;T - Text manipulation
  355.               (txtmenu)
  356.             )
  357.             ((or (= mmkey 85) (= mmkey 117))          ;U - Undo last Command
  358.               (prompt "\nAC<REGISTER> Register now and you can use UNDO!!")
  359.               (acpauz)
  360.               (mainprom)
  361.             )
  362.             ((or (= mmkey 87) (= mmkey 119))          ;W - redraW
  363.               (prompt "\n ")
  364.               (prompt "\nAC<REDRAW> Redraw...")
  365.               (command "Redraw")
  366.               (mainprom)
  367.               (setvar "COORDS" 0)
  368.             )
  369.             ((or (= mmkey 88) (= mmkey 120))          ;X - eXplode command
  370.               (cond
  371.                 ((= mmenm2 "PLINE")
  372.                   (setq mmmlp nil)
  373.                   (setq mmslp 1)
  374.                   (prompt "\n ")
  375.                   (prompt "\nAC<EXPLODE> Exploding polyline...")
  376.                   (command ".EXPLODE" mmslp2)
  377.                 )
  378.                 ((= mmenm "INSERT")
  379.                   (if (= mmbx mmby mmbz)
  380.                     (progn
  381.                       (setq mmmlp nil)
  382.                       (setq mmslp 1)
  383.                       (prompt "\n ")
  384.                       (prompt "\nAC<EXPLODE> Exploding Block...")
  385.                       (command ".EXPLODE" mmslp2)
  386.                     )
  387.                     (progn
  388.                       (prompt "\n ")
  389.                       (prompt
  390.      "\nAC<ERROR> Cannot explode Block - X, Y & Z scales differ - try again")
  391.                       (acpauz)
  392.                       (mainprom)
  393.                       (setvar "COORDS" 0)
  394.                     )
  395.                   )
  396.                 )
  397.                 ((or (/= mmenm "INSERT") (/= mmenm2 "PLINE"))
  398.                   (prompt "\n ")
  399.          (prompt "\nAC<ERROR> Cannot explode this entity - try again...")
  400.                   (acpauz)
  401.                   (mainprom)
  402.                   (setvar "COORDS" 0)
  403.                 )
  404.               )
  405.             )
  406.             ((or (= mmkey 90) (= mmkey 122))    ;Z - zoom
  407.               (zoomenu)
  408.             )
  409.           )
  410.         )
  411.         (progn
  412.           (if (and (not (member mmkey mmlist)) (and (> mmkey 0) (< mmkey 126)))
  413.             (progn
  414.               (prompt "\nAC<ERROR> Invalid key!!")
  415.               (acpauz)
  416.               (mainprom)
  417.             )
  418.             (progn
  419.               (setq mmslp (ssget mmkey))
  420.               (if (/= mmslp nil)
  421.                 (progn
  422.                   (setq mment mmkey)
  423.                   (setq mmslp2 mmslp)
  424.                 )
  425.               )
  426.             )
  427.           )
  428.         )
  429.       )
  430.     )
  431.     (setq mma (ssname mmslp2 0))
  432.     (setq mme mma
  433.           cominf (entget mma)
  434.           mmlyr (cdr (assoc 8 (entget mma)))
  435.           mmenm2 (cdr (assoc 0 (entget mma)))
  436.           mmenm nil
  437.           mmclr (cdr (assoc 62 (entget mma))))
  438.     (if (= mmenm2 "POLYLINE")
  439.       (setq mmenm2 "PLINE")
  440.     )
  441.     (if (= mmenm2 "INSERT")
  442.       (progn
  443.         (setq mmenm mmenm2)
  444.         (setq mmbx (rtos (cdr (assoc 41 (entget mma))) 2 1))
  445.         (setq mmby (rtos (cdr (assoc 42 (entget mma))) 2 1))
  446.         (setq mmbz (rtos (cdr (assoc 43 (entget mma))) 2 1))
  447.         (setq mmbxp (rtos (cdr (assoc 41 (entget mma))) 2 8))
  448.         (setq mmbyp (rtos (cdr (assoc 42 (entget mma))) 2 8))
  449.         (setq mmbzp (rtos (cdr (assoc 43 (entget mma))) 2 8))
  450.         (setq mmbang (rtos (rtd (cdr (assoc 50 (entget mma)))) 2 0))
  451.         (setq mmbnm (cdr (assoc 2 (entget mma))))
  452.         (if (= mmbx mmby mmbz)
  453.           (setq mmenm2 (strcat mmbnm "(" mmbx "<" mmbang ")"))
  454.           (if mmbz
  455.             (setq mmenm2 (strcat mmbnm "(" mmbx "," mmby "," mmbz "<" mmbang ")"))
  456.             (setq mmenm2 (strcat mmbnm "(" mmbx "," mmby "<" mmbang ")"))
  457.           )
  458.         )
  459.       )
  460.     )
  461.     (cond ((= mmclr 0) (setq mmsclr "BYBLOCK"))
  462.       ((or (= mmclr 256) (= mmclr nil)) (setq mmsclr "BYLAYER"))
  463.       ((= mmclr 1)  (setq mmsclr "RED"))
  464.       ((= mmclr 2)  (setq mmsclr "YELLOW"))
  465.       ((= mmclr 3)  (setq mmsclr "GREEN"))
  466.       ((= mmclr 4)  (setq mmsclr "CYAN"))
  467.       ((= mmclr 5)  (setq mmsclr "BLUE"))
  468.       ((= mmclr 6)  (setq mmsclr "MAGENTA"))
  469.       ((= mmclr 7)  (setq mmsclr "WHITE"))
  470.       ((= mmclr 8)  (setq mmsclr "8"))
  471.       ((= mmclr 9)  (setq mmsclr "9"))
  472.       ((= mmclr 10) (setq mmsclr "10"))
  473.       ((= mmclr 11) (setq mmsclr "11"))
  474.       ((= mmclr 12) (setq mmsclr "12"))
  475.       ((= mmclr 13) (setq mmsclr "13"))
  476.       ((= mmclr 14) (setq mmsclr "14"))
  477.       ((= mmclr 15) (setq mmsclr "15"))
  478.     )
  479.     (grtext -1 (strcat mmenm2 " on lyr: " mmlyr))
  480.     (grtext -2 (strcat " with color: " mmsclr))
  481.     (setq mmslp nil)
  482.   )
  483. )
  484. ;*************************************************************
  485. (spin)
  486. (defun drawcmnd ()
  487.   (if (= mmenm "INSERT") (setq mmenm2 "INSERT"))
  488.   (setq comnam mmenm2)
  489.   (if (= comnam "CIRCLE")(docirc))
  490.   (if (= comnam "INSERT")(doins))
  491.   (if (= comnam "LINE")(doline))
  492.   (if (= comnam "TEXT")
  493.     (progn
  494.       (setq comnam "DTEXT")
  495.       (dotext)
  496.     )
  497.   )
  498.   (if (= (MEMBER comnam '("CIRCLE" "LINE" "HATCH" "INSERT" "DTEXT")) nil)
  499.     (progn
  500.       (prompt "\n ")
  501.       (princ (strcat "\nAC<" comnam ">"))
  502.       (dolyr)
  503.       (command comnam)
  504.     )
  505.   )
  506.   (setvar "BLIPMODE" 1)
  507.   (setvar "CMDECHO" 1)
  508.   (setvar "MENUECHO" 0)
  509.   (setq *error* olderr)
  510.   (princ)
  511.   'OK
  512. )
  513. ;insert same block at same scale or different
  514. (spin)
  515. (defun doins (/ dibnm diyn dibx diby dibz)
  516.   (dolyr)
  517.   (setq diyn nil dibnm nil)
  518.   (if (= (substr (cdr (assoc 2 cominf)) 1 2) "*X")
  519.     (setq comnam "HATCH")
  520.     (progn
  521.       (setq dibnm (cdr (assoc 2 cominf)))
  522.       (prompt "\n ")
  523.       (initget "Yes No")
  524.       (setq diyn (getkword (strcat
  525.    "\nAC<INSERT> Insert selected block (" dibnm ") at same scale? <Y>/N: ")))
  526.       (if (= diyn nil)(setq diyn "Yes"))
  527.     )
  528.   )
  529.   (if (= diyn "Yes")
  530.     (progn
  531.       (setq dibx (cdr (assoc 41 cominf)))
  532.       (setq diby (cdr (assoc 42 cominf)))
  533.       (setq dibz (cdr (assoc 43 cominf)))
  534.       (prompt "\n ")
  535.       (princ (strcat "\nAC<INSERT>"))
  536.   (prompt "\nAC<INSERT> Pick or Enter Insertion Point and Rotation Angle...")
  537.   (command comnam dibnm "X" dibx "Y" diby pause pause)
  538.     )
  539.     (progn
  540.       (prompt "\n ")
  541.       (princ (strcat "\nAC<" comnam ">"))
  542.       (command comnam)
  543.     )
  544.   )
  545.   'OK
  546. )
  547. ;do circle from center of picked circle or elsewhere
  548. (spin)
  549. (defun docirc (/ dccen dcocen)
  550.   (dolyr)
  551.   (setq dcocen (cdr (assoc 10 cominf)))
  552.   (prompt "\n ")
  553.   (princ (strcat "\nAC<" comnam ">"))
  554.   (setq dccen
  555. (getpoint "\nAC<CIRCLE> <RETURN> for center of selected circle/Center point: "))
  556.   (if (= dccen nil) (setq dccen dcocen))
  557.   (command comnam dccen)
  558.   'OK
  559. )
  560. ;continue line from nearest endpoint or elsewhere
  561. (spin)
  562. (defun doline (/ dldi1 dldi2 dlstrt dlend1 dlend2)
  563.   (dolyr)
  564.   (prompt "\n ")
  565.   (princ (strcat "\nAC<" comnam ">"))
  566.   (setq dlend1 (cdr (assoc 10 cominf))
  567.         dlend2 (cdr (assoc 11 cominf))
  568.         dldi1 (distance dlend1 mment)
  569.         dldi2 (distance dlend2 mment))
  570.   (if (< dldi1 dldi2)
  571.     (setq dlstrt1 dlend1)
  572.     (setq dlstrt1 dlend2)
  573.   )
  574.   (setq dlstrt
  575.     (getpoint "\nAC<LINE> <RETURN> for nearest endpoint/From point: "))
  576.   (if (= dlstrt nil)
  577.     (command comnam dlstrt1)
  578.     (command comnam dlstrt)
  579.   )
  580.   'OK
  581. )
  582. (spin)
  583. (defun dotext (/ dtang dtclyr dtcont dthyt dtinf dtins dtins2 dtj1 dtj2
  584.                  dtjust dtlast dtlen dtnext dtlyr dttext dtxset dtstop
  585.                  dtstyl dtstylh dtxlst dtxval dtxxlst)
  586.   (setvar "BLIPMODE" 1)
  587.   (setvar "CMDECHO" 0)
  588.   (setvar "MENUECHO" 2)
  589.   (setvar "COORDS" 1)
  590.   (prompt "\n ")
  591.   (princ (strcat "\n\nAC<" comnam ">"))
  592.   (prompt "\nAC<TEXT> Press E to start text elsewhere or")
  593.   (initget "E")
  594.   (setq dtcont (getkword "\nAC<TEXT> <RETURN> to continue after picked line:"))
  595.   (setq dtstop nil)
  596.   (setq dtxset (ssadd))
  597.   (setq dtlast (entlast))
  598.   (if (= dtcont nil)
  599.     (progn
  600.       (setq dtinf cominf)
  601.       (setq dtlyr (cdr (assoc 8 dtinf))
  602.       dtclyr (getvar "CLAYER")
  603.       dtstyl (cdr (assoc 7 dtinf))
  604.       dtstylh (cdr (assoc 40 (tblsearch "STYLE" dtstyl)))
  605.       dtxval (cdr (assoc 41 dtinf)))
  606.       (if (/= dtxval 1)
  607.         (progn
  608.           (setq dtxval1 (rtos dtxval 2 2))
  609. (prompt (strcat "\nAC<TEXT> NOTE: Text X-Scale factor is " dtxval1 " and will be changed accordingly"))
  610.           (prompt "\nAC<TEXT>       Take this into consideration for the margins")
  611.           (acpauz)
  612.         )
  613.       )
  614.       (if (= dtstylh 0)
  615.         (setq dthyt (cdr (assoc 40 dtinf)))
  616.         (setq dthyt nil)
  617.       )
  618.       (setq dtins (cdr (assoc 10 dtinf))
  619.             dtang (cdr (assoc 50 dtinf))
  620.             dtj1 (cdr (assoc 72 dtinf))
  621.             dtj2 (cdr (assoc 73 dtinf)))
  622.       (cond
  623.         ((= dtj1 0)
  624.           (cond ((= dtj2 1)(setq dtjust "bl" dtins (cdr (assoc 11 dtinf))))
  625.                 ((= dtj2 2)(setq dtjust "ml" dtins (cdr (assoc 11 dtinf))))
  626.                 ((= dtj2 3)(setq dtjust "tl" dtins (cdr (assoc 11 dtinf))))
  627.           )
  628.         )
  629.         ((= dtj1 1)
  630.           (cond ((= dtj2 0)(setq dtjust "c"  dtins (cdr (assoc 11 dtinf))))
  631.                 ((= dtj2 1)(setq dtjust "bc" dtins (cdr (assoc 11 dtinf))))
  632.                 ((= dtj2 2)(setq dtjust "mc" dtins (cdr (assoc 11 dtinf))))
  633.                 ((= dtj2 3)(setq dtjust "tc" dtins (cdr (assoc 11 dtinf))))
  634.           )
  635.         )
  636.         ((= dtj1 2)
  637.           (cond ((= dtj2 0)(setq dtjust "r"  dtins (cdr (assoc 11 dtinf))))
  638.                 ((= dtj2 1)(setq dtjust "br" dtins (cdr (assoc 11 dtinf))))
  639.                 ((= dtj2 2)(setq dtjust "mr" dtins (cdr (assoc 11 dtinf))))
  640.                 ((= dtj2 3)(setq dtjust "tr" dtins (cdr (assoc 11 dtinf))))
  641.           )
  642.         )
  643.         ((= dtj1 4)(setq dtjust "m" dtins (cdr (assoc 11 dtinf)))
  644.         )
  645.         ((or (= dtj1 3) (= dtj1 5))
  646.  (prompt "\nAC<TEXT> Error: This routine will not work on ALIGNED or FIT text")
  647.           (setq dtstop 1)
  648.           (acpauz)
  649.         )
  650.       )
  651.       (if (null dtstop)
  652.         (progn
  653.           (command ".LAYER" "S" dtlyr "")
  654.           (if (= dtstylh 0)
  655.             (if (and (= dtj1 0) (= dtj2 0))
  656.               (dtext1)
  657.               (dtext2)
  658.             )
  659.             (if (and (= dtj1 0) (= dtj2 0))
  660.               (dtext3)
  661.               (dtext4)
  662.             )
  663.           )
  664.           (if (/= dtxval 1)
  665.             (progn
  666.               (setvar "HIGHLIGHT" 1)
  667.               (setq dtnext (entnext dtlast))
  668.               (while dtnext
  669.                 (setq dtxset (ssadd dtnext dtxset))
  670.                 (setq dtlast dtnext)
  671.                 (setq dtnext (entnext dtlast))
  672.               )
  673.               (setq dtlen (sslength dtxset)
  674.                     dtindex 0)
  675.               (while (< dtindex dtlen)
  676.                 (setq dttext (entget (ssname dtxset dtindex))
  677.                       dtxxlst (assoc 41 dttext)
  678.                       dtxlst (cons 41 dtxval)
  679.                       dttext (subst dtxlst dtxxlst dttext))
  680.                 (entmod dttext)
  681.                 (setq dtindex (1+ dtindex))
  682.               )
  683.             )
  684.           )
  685.           (command ".LAYER" "S" dtclyr "")
  686.         )
  687.       )
  688.     )
  689.     (progn
  690.       (setvar "CMDECHO" 0)
  691.       (setvar "MENUECHO" 1)
  692.       (command comnam)
  693.     )
  694.   )
  695.   (princ)
  696.   (setvar "COORDS" 1)
  697.   (setvar "BLIPMODE" 1)
  698.   (setvar "CMDECHO" 1)
  699.   (setvar "MENUECHO" 0)
  700.   (setq *error* olderr)
  701. )
  702. (spin)
  703. ;continue text from that picked (style, height, rotation, just., etc.)
  704. (defun dtext1 ()
  705.   (prompt "\nAC<TEXT> Enter text and continue...")
  706.   (command ".TEXT" "s" dtstyl dtins dthyt (rtd dtang) "."
  707.     ".TEXT" "" ".")
  708.   (getins)
  709.   (command ".ERASE" "L" ""
  710.     ".ERASE" "L" ""
  711.     ".DTEXT" dtins2 dthyt (rtd dtang))
  712. )
  713. (defun dtext2 ()
  714.   (prompt "\nAC<TEXT> Enter text and continue...")
  715.   (command ".TEXT" "s" dtstyl dtjust dtins dthyt (rtd dtang) "."
  716.     ".TEXT" "" ".")
  717.   (getins)
  718.   (command ".ERASE" "L" ""
  719.     ".ERASE" "L" ""
  720.     ".DTEXT" dtjust dtins2 dthyt (rtd dtang))
  721. )
  722. (spin)
  723. (defun dtext3 ()
  724.   (prompt "\nAC<TEXT> Enter text and continue...")
  725.   (command ".TEXT" "s" dtstyl dtins (rtd dtang) "."
  726.     ".TEXT" "" ".")
  727.   (getins)
  728.   (command ".ERASE" "L" ""
  729.     ".ERASE" "L" ""
  730.     ".DTEXT" dtins2 (rtd dtang))
  731. )
  732. (defun dtext4 ()
  733.   (prompt "\nAC<TEXT> Enter text and continue...")
  734.   (command ".TEXT" "s" dtstyl dtjust dtins (rtd dtang) "."
  735.     ".TEXT" "" ".")
  736.   (getins)
  737.   (command ".ERASE" "L" ""
  738.     ".ERASE" "L" ""
  739.     ".DTEXT" dtjust dtins2 (rtd dtang))
  740. )
  741. (defun getins ()
  742.   (setq dtins2 (cdr (assoc 10 (entget (entlast)))))
  743. )
  744. (defun DOLYR (/ dlynlyr)
  745.   (setq dlynlyr (cdr (assoc 8 cominf)))
  746.   (command ".LAYER" "S" dlynlyr "")
  747.   (princ)
  748. )
  749. *************************************************************
  750. (spin)
  751. (defun LYRMENU (/ lya lyclr lyclyr lye lyenm lyent lyexp lykey lylist
  752.                   lylyr lymlp lyscan lyslp lyyn)
  753.   (setvar "SNAPMODE" 0)
  754.   (setvar "CMDECHO" 0)
  755.   (setvar "MENUECHO" 2)
  756.   (setvar "HIGHLIGHT" 0)
  757.   (setvar "COORDS" 0)
  758.   (lyrprom)
  759.   (setq lyrlist (list 49 65 97 68 100 70 102 79 111 83 115
  760. ;                      1  A  a  D   d  F   f  O   o  S   s
  761.           81 113 88 120 63))
  762. ;          Q   q  X   x  ?
  763.   (setq lymlp 1)
  764.   (while lymlp
  765.     (setq lyslp nil)
  766.     (while (not lyslp)
  767.       (setq lyscan (grread 1))
  768.       (setq lykey (car (cdr lyscan)))
  769.       (if (member lykey lyrlist)
  770.         (progn
  771.           (cond
  772.             ((= lykey 63)                    ;? - Help
  773.               (lyrhelp)
  774.             )
  775.             ((or (= lykey 65) (= lykey 97))     ;A - All on
  776.               (command ".LAYER" "ON" "*" "")
  777.               (setq lymlp nil)
  778.               (mainprom)
  779.             )
  780.             ((or (= lykey 83) (= lykey 115))    ;S - set current
  781.               (prompt "\nAC<REGISTER> Register now and you can use SET!!")
  782.               (acpauz)
  783.               (mainprom)
  784.             )
  785.             ((or (= lykey 68) (= lykey 100))    ;D - delete all entities
  786.               (prompt "\nAC<REGISTER> Register now and you can use DELETE!!")
  787.               (acpauz)
  788.               (mainprom)
  789.             )
  790.             ((or (= lykey 70) (= lykey 102))    ;F - Freeze
  791.               (setq lyclyr (getvar "CLAYER"))
  792.               (if (= lyclyr lylyr)
  793.                 (progn
  794.                   (prompt "\n ")
  795.                   (prompt "\nAC<ERROR> Current layer cannot be frozen !!")
  796.                   (prompt "\nAC<ERROR> Set new current layer and try again.")
  797.                   (acpauz)
  798.                   (lyrmenu)
  799.                 )
  800.                 (progn
  801.                   (command ".LAYER" "F" lylyr "")
  802.                   (setq lymlp nil)
  803.                   (mainprom)
  804.                 )
  805.               )
  806.             )
  807.             ((or (= lykey 79) (= lykey 111))    ;O - Off
  808.               (setq lyclyr (getvar "CLAYER"))
  809.               (if (= lyclyr lylyr)
  810.                 (progn
  811.                   (prompt "\n ")
  812.                   (prompt "\nAC<ERROR> Current layer should not be off.")
  813.                   (prompt "\nAC<ERROR> Set new current layer and try again.")
  814.                   (acpauz)
  815.                   (lyrmenu)
  816.                 )
  817.                 (progn
  818.                   (command ".LAYER" "OF" lylyr "")
  819.                   (setq lymlp nil)
  820.                   (mainprom)
  821.                 )
  822.               )
  823.             )
  824.             ((= lykey 49)        ;1 - set & all others off
  825.               (setq lyexp (getvar "EXPERT"))
  826.               (setvar "EXPERT" 0)
  827.               (command ".LAYER" "S" lylyr "OF" "*" "N" "")
  828.               (setvar "EXPERT" lyexp)
  829.               (setq lymlp nil)
  830.               (mainprom)
  831.             )
  832.             ((or (= lykey 81) (= lykey 113))   ;Q - Quit
  833. (prompt "\n\nAC<QUIT>                       AUTOCOMMAND !")
  834. (prompt "\nAC<QUIT> The routine that will REVOLUTIONIZE the way you use AutoCad!!")
  835.               (setq mmmlp nil)
  836.               (setq mmslp 1)
  837.               (setq lymlp nil)
  838.               (setq lyslp 1)
  839.             )
  840.             ((or (= lykey 88) (= lykey 120))   ;X - eXit back to Main menu
  841.               (setq lymlp nil)
  842.               (setq lyslp 1)
  843.               (editmenu)
  844.             )
  845.           )
  846.         )
  847.         (progn
  848.           (if (and (not (member lykey lylist)) (and (> lykey 0) (< lykey 126)))
  849.             (progn
  850.               (prompt "\nAC<ERROR> Invalid key!!")
  851.               (acpauz)
  852.               (lyrprom)
  853.             )
  854.             (setq lyslp (ssget lykey))
  855.           )
  856.         )
  857.       )
  858.     )
  859.     (setq lya (ssname lyslp 0))
  860.     (setq lye lya
  861.           lylyr (cdr (assoc 8 (entget lya)))
  862.           lyenm2 (cdr (assoc 0 (entget lya)))
  863.           lyclr (cdr (assoc 62 (entget lya))))
  864.     (if (= lyenm2 "POLYLINE")
  865.       (setq lyenm2 "PLINE")
  866.     )
  867.     (if (= lyenm2 "INSERT")
  868.       (setq lyenm2 (strcat "BLK: " (cdr (assoc 2 (entget lya)))))
  869.     )
  870.     (if lyclr
  871.       (if (/= lyclr 256)
  872.         (setq lyenm2 (strcat "*" lyenm2))
  873.       )
  874.     )
  875.     (grtext -2 (strcat lyenm2 " on LYR: " lylyr))
  876.     (setq lyslp nil)
  877.   )
  878. )
  879. (spin)
  880. (defun zoomenu (/ zoexp zopp1 zopp2 zokey zosmpt zowp1 zowp2)
  881.   (setvar "CMDECHO" 0)
  882.   (setvar "MENUECHO" 2)
  883.   (setvar "COORDS" 1)
  884.   (setvar "HIGHLIGHT" 0)
  885.   (setq zoexp (getvar "EXPERT"))
  886.   (setvar "EXPERT" 5)
  887.   (zoomprom)
  888.   (initget "A a B b E e P p S s W w 2 D d L l R r U u X x Q q ?")
  889.   (setq zokey
  890.  (getkword "\nAC<ZOOM> Press 2/A/B/D/E/L/P/Q/R/S/U/W/X/? and Enter: <W>  "))
  891.   (if (= zokey nil)
  892.     (setq zokey "W")
  893.   )
  894.   (cond
  895.     ((= zokey "?")  ;? - Help
  896.        (zoomhelp)
  897.     )
  898.     ((= zokey "2")         ;2 - pan 2 points
  899.        (prompt "\n ")
  900.    (setq zopp1 (getpoint "\nAC<ZOOM> 2 Point Pan: Pick first point to pan..."))
  901.    (setq zopp2 (getpoint zopp1 "\nAC<ZOOM> 2 Point pan: Pick second point..."))
  902.        (command ".PAN" zopp1 zopp2)
  903.        (setvar "EXPERT" zoexp)
  904.        (mainprom)
  905.     )
  906.     ((or (= zokey "A") (= zokey "a"))     ;A - zoom all
  907.        (command ".ZOOM" "A")
  908.        (setvar "EXPERT" zoexp)
  909.        (mainprom)
  910.     )
  911.     ((or (= zokey "B") (= zokey "b"))     ;B - zoom Biggest
  912.        (command ".ZOOM" "V")
  913.        (setvar "EXPERT" zoexp)
  914.        (mainprom)
  915.     )
  916.     ((or (= zokey "D") (= zokey "d"))     ;D - Pan Down
  917.        (prompt "\nAC<REGISTER> Register now and you can use PAN!!")
  918.        (acpauz)
  919.        (mainprom)
  920.     )
  921.     ((or (= zokey "E") (= zokey "e"))     ;E - zoom extents
  922.        (command ".ZOOM" "E")
  923.        (setvar "EXPERT" zoexp)
  924.        (mainprom)
  925.     )
  926.     ((or (= zokey "L") (= zokey "l"))     ;L - Pan Left
  927.        (prompt "\nAC<REGISTER> Register now and you can use PAN!!")
  928.        (acpauz)
  929.        (mainprom)
  930.     )
  931.     ((or (= zokey "P") (= zokey "p"))     ;P - Zoom Previous
  932.        (command ".ZOOM" "P")
  933.        (setvar "EXPERT" zoexp)
  934.        (mainprom)
  935.     )
  936.     ((or (= zokey "Q") (= zokey "q"))
  937. (prompt "\n\nAC<QUIT>                       AUTOCOMMAND !")
  938. (prompt "\nAC<QUIT> The routine that will REVOLUTIONIZE the way you use AutoCad!!")
  939.       (setq mmmlp nil)
  940.       (setq mmslp 1)
  941.     )
  942.     ((or (= zokey "R") (= zokey "r"))     ;R - Pan Right
  943.        (prompt "\nAC<REGISTER> Register now and you can use PAN!!")
  944.        (acpauz)
  945.        (mainprom)
  946.     )
  947.     ((or (= zokey "S") (= zokey "s"))     ;S - Zoom Smallest
  948.        (prompt "\nAC<REGISTER> Register now and you can use ZOOM SMALLEST!!")
  949.        (acpauz)
  950.        (mainprom)
  951.     )
  952.     ((or (= zokey "U") (= zokey "u"))     ;U - Pan Up
  953.        (prompt "\nAC<REGISTER> Register now and you can use PAN!!")
  954.        (acpauz)
  955.        (mainprom)
  956.     )
  957.     ((or (= zokey "W")(= zokey "w"))      ;W - Zoom Window
  958.        (prompt "\n ")
  959.        (setq zowp1
  960.        (getpoint "\nAC<ZOOM> Window: Pick first corner of zoom window..."))
  961.        (setq zowp2 (getcorner zowp1 "\nAC<ZOOM> Window: Pick second corner..."))
  962.        (command "zoom" "W" zowp1 zowp2)
  963.        (setvar "EXPERT" zoexp)
  964.        (mainprom)
  965.     )
  966.     ((or (= zokey "X") (= zokey "x"))      ;X - Exit to Main Menu
  967.        (setvar "EXPERT" zoexp)
  968.        (editmenu)
  969.     )
  970.   )
  971. )
  972. (spin)
  973. (defun TXTMENU (/ txapt1 txapt2 cxchk txcode txcon txent txenta txh
  974.                   txindex txinf txins1 txins2 txj txj0 txj1 txj2 txjcon
  975.                   txjcon2 txcount txkey txlist txloop txmlp txnlen
  976.                   txnstr txnum txoch txostr txolen txchpos txscan txslp
  977.                   txss txstatj txstr txstrl txxstyl txt0 txt1 txt7 txt40
  978.                   txtlen txtlist txtp1 txtp2 txvalu txxs)
  979.   (setvar "SNAPMODE" 0)
  980.   (setvar "CMDECHO" 0)
  981.   (setvar "MENUECHO" 2)
  982.   (setvar "HIGHLIGHT" 0)
  983.   (setvar "COORDS" 0)
  984.   (textprom)
  985.   (setq txtlist (list 67 99 69 101 72 104 74 106 81 113 82 114 83 115 86 118
  986. ;                      C  c  E   e  H   h  J   j  Q   q  R   r  S   s  V   v  
  987.                       87 119 88 120 63))
  988.                        W   w  X    x  ?
  989.   (setq txmlp 1)
  990.   (while txmlp
  991.     (setq txslp nil)
  992.     (while (not txslp)
  993.       (setq txscan (grread 1))
  994.       (setq txkey (car (cdr txscan)))
  995.       (if (member txkey txtlist)
  996.         (progn
  997.           (setvar "CMDECHO" 1)
  998.           (setvar "MENUECHO" 0)
  999.           (setvar "HIGHLIGHT" 1)
  1000.           (setvar "COORDS" 1)
  1001.           (cond
  1002.             ((= txkey 63)                      ;? - Text help
  1003.               (txthelp)
  1004.             )
  1005.             ((or (= txkey 67) (= txkey 99))      ;C - Continue
  1006.                (prompt "\nAC<REGISTER> Register now and you can use CONTINUE!!")
  1007.                (acpauz)
  1008.                (mainprom)
  1009.             )
  1010.             ((or (= txkey 69) (= txkey 101))     ;E - Edit text
  1011.               (setq txslp nil)
  1012.               (setq txmlp nil)
  1013.               (setq mmmlp nil)
  1014.               (setq mmslp nil)
  1015.               (command ".DDEDIT" txent)
  1016.             )
  1017.             ((or (= txkey 72) (= txkey 104))     ;H - Height
  1018.               (setq txmlp nil)
  1019.               (prompt "\n ")
  1020.               (prompt "\nAC<TEXT> Height: Select text: <Enter for all> ")
  1021.               (setq txss (ssget))
  1022.               (if (= txss nil)
  1023.                 (progn
  1024.                   (setq txss (ssget "X" (list (cons 0 "TEXT"))))
  1025.                   (if (= txss nil)
  1026.                     (setq txnum "0")
  1027.                     (setq txnum (itoa (sslength txss)))
  1028.                   )
  1029.                   (prompt (strcat "\n *  " txnum " lines of text selected..."))
  1030.                 )
  1031.                 (progn
  1032.                   (setq txnum (itoa (sslength txss)))
  1033.                   (prompt (strcat "\n *  " txnum " entities of text selected..."))
  1034.                 )
  1035.               )
  1036.               (if (null $txh)
  1037.                 (setq $txh 0)
  1038.               )
  1039.               (setq txh (getreal (strcat
  1040.                   "\nAC<TEXT> Height: Enter new height <" (rtos $txh) ">: ")))
  1041.               (if (= txh nil)
  1042.                 (setq txh $txh)
  1043.                 (setq $txh txh)
  1044.               )
  1045.               (setq txcode 40)
  1046.               (chgtxt txh)
  1047.               (setvar "COORDS" 0)
  1048.               (mainprom)
  1049.             )
  1050.             ((or (= txkey 74) (= txkey 106))     ;J - Justification
  1051.        (prompt "\nAC<REGISTER> Register now and you can use JUSTIFY!!")
  1052.                (acpauz)
  1053.                (mainprom)
  1054.             )
  1055.             ((or (= txkey 81) (= txkey 113))     ;Q - Quit
  1056. (prompt "\n\nAC<QUIT>                       AUTOCOMMAND !")
  1057. (prompt "\nAC<QUIT> The routine that will REVOLUTIONIZE the way you use AutoCad!!")
  1058.               (setq mmmlp nil)
  1059.               (setq mmslp 1)
  1060.               (setq txmlp nil)
  1061.               (setq txslp 1)
  1062.             )
  1063.             ((or (= txkey 82) (= txkey 114))     ;Replacement
  1064.               (setq txmlp nil
  1065.                     txcount 0)
  1066.               (prompt "\n ")
  1067.               (prompt "\nAC<TEXT> Replace: Select text: <Enter for all> ")
  1068.               (setq txss (ssget))
  1069.               (if (= txss nil)
  1070.                 (progn
  1071.                   (setq txss (ssget "X" (list (cons 0 "TEXT"))))
  1072.                   (if (= txss nil)
  1073.                     (setq txnum "0")
  1074.                     (setq txnum (itoa (sslength tss)))
  1075.                   )
  1076.                   (prompt (strcat "\nAC<TEXT> Replace: " txnum " lines of text selected..."))
  1077.                 )
  1078.                 (progn
  1079.                   (setq txnum (itoa (sslength txss)))
  1080.                   (prompt (strcat "\nAC<TEXT> Replace: " txnum " entities selected..."))
  1081.                 )
  1082.               )
  1083.               (while
  1084.                 (= 0 (setq txolen (strlen
  1085.                   (setq txostr (getstring t "\nAC<TEXT> Replace: Old String: ")))))
  1086.                   (prompt "AC<TEXT> Replace: Null input invalid!")
  1087.               )
  1088.               (setq txnlen (strlen (setq txnstr
  1089.                   (getstring t "\nAC<TEXT> Replace: New string: "))))
  1090.               (setq txindex 0
  1091.                     txnum (sslength txss))
  1092.               (while (< txindex txnum)
  1093.                 (if (= "TEXT" (cdr (assoc 0 (setq txlist (entget (ssname txss txindex))))))
  1094.                   (progn
  1095.                     (setq txchk nil
  1096.                           txchpos 1
  1097.                           txstr (cdr (setq txstrl (assoc 1 txlist))))
  1098.                     (while (= txolen (strlen (setq txoch (substr txstr txchpos txolen))))
  1099.                       (if (= txoch txostr)
  1100.                         (progn
  1101.                           (setq txstr (strcat(substr txstr 1 (1- txchpos)) txnstr(substr txstr (+ txchpos txolen)))
  1102.                                 txchk t
  1103.                                 txchpos (+ txchpos txnlen))
  1104.                         )
  1105.                         (setq txchpos (1+ txchpos))
  1106.                       )
  1107.                     )
  1108.                     (if txchk
  1109.                       (progn
  1110.                         (setq txlist (subst (cons 1 txstr) txstrl txlist))
  1111.                         (entmod txlist)
  1112.                         (setq txcount (1+ txcount))
  1113.                       )
  1114.                     )
  1115.                   )
  1116.                 )
  1117.                 (setq txindex (1+ txindex))
  1118.               )
  1119.               (prompt "\nAC<TEXT> Replace: Changed ")
  1120.               (princ txcount)
  1121.               (princ " text lines.")
  1122.               (setvar "COORDS" 0)
  1123.               (setq txmlp nil)
  1124.               (mainprom)
  1125.             )
  1126.             ((or (= txkey 83) (= txkey 115))     ;S - Style
  1127.        (prompt "\nAC<REGISTER> Register now and you can use STYLE!!")
  1128.                (acpauz)
  1129.                (mainprom)
  1130.             )
  1131.             ((or (= txkey 86) (= txkey 118))     ;V - x-Value
  1132.               (setq txmlp nil)
  1133.               (prompt "\n ")
  1134.               (prompt "\nAC<TEXT> x-Value: Select text: <Enter for all> ")
  1135.               (setq txss (ssget))
  1136.               (if (= txss nil)
  1137.                 (progn
  1138.                   (setq txss (ssget "X" (list (cons 0 "TEXT"))))
  1139.                   (if (= txss nil)
  1140.                     (setq txnum "0")
  1141.                     (setq txnum (itoa (sslength txss)))
  1142.                   )
  1143.                   (prompt (strcat "\nAC<TEXT> x-Value: " txnum " lines of text selected..."))
  1144.                 )
  1145.                 (progn
  1146.                   (setq txnum (itoa (sslength txss)))
  1147.                   (prompt (strcat "\nAC<TEXT> x-Value: " txnum " entities of text selected..."))
  1148.                 )
  1149.               )
  1150.               (if (null $txv)
  1151.                 (setq $txv 1)
  1152.               )
  1153.               (setq txvalu (getreal (strcat
  1154.                   "\nAC<TEXT> x-Value: Enter new x-scale: <" (rtos $txv) ">: ")))
  1155.               (if (= txvalu nil)
  1156.                 (setq txvalu $txv)
  1157.                 (setq $txv txvalu)
  1158.               )
  1159.               (setq txcode 41)
  1160.               (chgtxt txvalu)
  1161.               (setvar "COORDS" 0)
  1162.               (mainprom)
  1163.             )
  1164.             ((or (= txkey 87) (= txkey 119))   ;W - redraW
  1165.               (command ".REDRAW")
  1166.               (setvar "COORDS" 0)
  1167.               (textprom)
  1168.             )
  1169.             ((or (= txkey 88) (= txkey 120))   ;X - eXit back to Main menu
  1170.               (setq txmlp nil)
  1171.               (setq txslp 1)
  1172.               (editmenu)
  1173.             )
  1174.           )
  1175.         )
  1176.         (progn
  1177.           (if (and (not (member txkey txtlist)) (and (> txkey 0) (< txkey 126)))
  1178.             (progn
  1179.               (prompt "\nAC<ERROR> Invalid key!!")
  1180.               (acpauz)
  1181.               (textprom)
  1182.             )
  1183.             (progn
  1184.               (setq txslp (ssget txkey))
  1185.               (if (/= txslp nil)
  1186.                 (progn
  1187.                   (setq txent txkey)
  1188.                   (setq txslp2 txslp)
  1189.                 )
  1190.               )
  1191.             )
  1192.           )
  1193.         )
  1194.       )
  1195.     )
  1196.     (setq txinf (ssname txslp 0))
  1197.     (setq txlist txinf
  1198.           cominf (entget txinf)
  1199.           txt0  (cdr (assoc 0 (entget txinf))))
  1200.    (if (= txt0 "TEXT")
  1201.      (progn
  1202.         (setq txt1  (cdr (assoc 1 (entget txinf)))
  1203.               txt7  (cdr (assoc 7 (entget txinf)))
  1204.               txt40 (cdr (assoc 40 (entget txinf)))
  1205.               txtlen (strlen txt1)
  1206.               txtp1 (cdr (assoc 72 (entget txinf)))
  1207.               txtp2 (cdr (assoc 73 (entget txinf)))
  1208.               txt41 (cdr (assoc 41 (entget txinf)))
  1209.         )
  1210.         (if (> txtlen 25)
  1211.           (progn
  1212.             (setq txt1 (substr txt1 1 20))
  1213.             (setq txt1 (strcat txt1 "..."))
  1214.           )
  1215.         )
  1216.         (cond
  1217.           ((= txtp2 0)
  1218.             (cond
  1219.               ((= txtp1 0) (setq txstatj "L"))
  1220.               ((= txtp1 1) (setq txstatj "C"))
  1221.               ((= txtp1 2) (setq txstatj "R"))
  1222.               ((= txtp1 3) (setq txstatj "A"))
  1223.               ((= txtp1 4) (setq txstatj "M"))
  1224.               ((= txtp1 5) (setq txstatj "F"))
  1225.             )
  1226.           )
  1227.           ((= txtp2 1)
  1228.             (cond
  1229.               ((= txtp1 0) (setq txstatj "BL"))
  1230.               ((= txtp1 1) (setq txstatj "BC"))
  1231.               ((= txtp1 2) (setq txstatj "BR"))
  1232.             )
  1233.           )
  1234.           ((= txtp2 2)
  1235.             (cond
  1236.               ((= txtp1 0) (setq txstatj "ML"))
  1237.               ((= txtp1 1) (setq txstatj "MC"))
  1238.               ((= txtp1 2) (setq txstatj "MR"))
  1239.             )
  1240.           )
  1241.           ((= txtp2 3)
  1242.             (cond
  1243.               ((= txtp1 0) (setq txstatj "TL"))
  1244.               ((= txtp1 1) (setq txstatj "TC"))
  1245.               ((= txtp1 2) (setq txstatj "TR"))
  1246.             )
  1247.           )
  1248.         )
  1249.         (if (= txt41 1)
  1250. (grtext -1 (strcat "TXT - J:"txstatj " S:" txt7 " H:" (rtos txt40 2 2)))
  1251. (grtext -1 (strcat "TXT - W:" (rtos txt41 2 2) " J:" txstatj " S:" txt7 " H:" (rtos txt40 2 2)))
  1252.         )
  1253.         (grtext -2 (strcat "\"" txt1 "\""))
  1254.       )
  1255.     )
  1256.     (setq txslp nil)
  1257.   )
  1258. )
  1259.  
  1260. (defun chgtxt (txp / ctindex tlen)
  1261.   (setq ctlen (sslength txss)
  1262.         ctindex 0)
  1263.   (while (< ctindex ctlen)
  1264.     (setq ctlist (entget (ssname txss ctindex)))
  1265.     (if (= (cdr (assoc 0 ctlist)) "TEXT")
  1266.       (setq ctlist (subst (cons txcode txp) (assoc txcode ctlist) ctlist))
  1267.     )
  1268.     (entmod ctlist)
  1269.     (setq ctindex (1+ ctindex))
  1270.   )
  1271. )
  1272.  
  1273. (princ "->")
  1274. (prompt "\nAC<LOAD> UNREGISTERED AUTOCOMMAND (Version 3.0) loaded...type AC to run...")
  1275. (princ)
  1276.